home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / cg.lha / cg / src / sem.puma < prev    next >
Text File  |  1992-11-24  |  48KB  |  1,614 lines
  1. /* Ich, Doktor Josef Grosch, Informatiker, 23.5.1989 */
  2.  
  3. TRAFO Semantics
  4. TREE Tree
  5. PUBLIC Semantics
  6.  
  7. EXPORT { VAR TypeCount: SHORTCARD; }
  8.  
  9. GLOBAL {
  10.  
  11. FROM SYSTEM    IMPORT TSIZE, ADR;
  12. FROM General    IMPORT Max;
  13. FROM IO        IMPORT StdOutput, WriteN, WriteS, WriteI, WriteNl;
  14. FROM DynArray    IMPORT MakeArray;
  15. FROM StringMem    IMPORT tStringRef;
  16. FROM Strings    IMPORT tString, IntToString, Append, Concatenate, ArrayToString,
  17.             Length, Char;
  18. FROM Idents    IMPORT WriteIdent, tIdent, NoIdent, MakeIdent, MaxIdent, GetString;
  19. FROM Texts    IMPORT MakeText;
  20.  
  21. FROM Sets    IMPORT
  22.    tSet        , MakeSet    , ReleaseSet    , AssignEmpty    ,
  23.    IsElement    , Include    , IsEmpty    , Extract    ,
  24.    Select    , Difference    , Complement    , ForallDo    ;
  25.  
  26. FROM Relations    IMPORT tRelation, MakeRelation, IsCyclic, GetCyclics, Assign, IsRelated;
  27. FROM Positions    IMPORT NoPosition;
  28.  
  29. FROM Tree    IMPORT
  30.    NoTree    , tTree        , tInstance    , tInstancePtr    ,
  31.    Computed    , Reverse    , Write        , Read        ,
  32.    Inherited    , Synthesized    , Input        , Output    ,
  33.    Stack    , Variable    , Ignore    , CopyDef    ,
  34.    CopyUse    , Thread    , NoAttribute    , MultInhComp    ,
  35.    Test        , Left        , Right        , NoCodeAttr    ,
  36.    NonBaseComp    , Dummy        , Terminal    ,
  37.    Nonterminal    , HasChildren    , HasAttributes    , HasActions    ,
  38.    Reachable    , Referenced    , Implicit    , mActionPart    ,
  39.    mClass    , mAttribute    , mChild    , mIdent    ,
  40.    mCopy    , mDesignator    , MaxSet    , WriteName    ,
  41.    Options    , TreeRoot    , ForallClasses    , ForallAttributes,
  42.    GrammarClass    , cLNC        , WriteDependencies, WriteClass    ,
  43.    IdentifyClass, IdentifyAttribute, IdentifyModule, TypeNames    ,
  44.    ClassCount    , nNoClass    , nNoAttribute    , nNoDesignator    ,
  45.    nNoAction    , nNoName    , iPosition    , itPosition    ,
  46.    WriteCyclics    , HasItem    , Mark        , Abstract    ,
  47.    InitIdentifyClass, InitIdentifyClass2;
  48.    
  49. IMPORT Relations, StringMem, Errors;
  50.  
  51. CONST
  52. # include "/tmp/cg/consts1"
  53.  
  54. VAR
  55.    CopyInherited, CopySynthesized, CopyThreaded,
  56.    ChildCount, AttributeCount, ActionCount: INTEGER;
  57.    ItemCount    ,
  58.    ChecksCount    ,
  59.    ReverseCount    : INTEGER;
  60.    iNull    ,
  61.    Ident    : tIdent;
  62.    ClassNames    ,
  63.    SelectorNames,
  64.    VariantNames    ,
  65.    PrecNames    ,
  66.    CodesUsed    ,
  67.    Results    ,
  68.    Arguments    ,
  69.    Cyclics    : tSet;
  70.    MaxInstCount    ,
  71.    TokenCode    ,
  72.    DummyIndex    ,
  73.    i, j, k    : SHORTCARD;
  74.    InstanceSize    : LONGINT;
  75.    IsAbstract    ,
  76.    Success    : BOOLEAN;
  77.    Module    ,
  78.    Node        ,
  79.    Attribute    ,
  80.    Child    ,
  81.    TheAction    ,
  82.    TheClass    ,
  83.    Class    : tTree;
  84.    String    ,
  85.    String2    : tString;
  86.    ActProperties: BITSET;
  87.  
  88. PROCEDURE LookUp (i: tIdent; t: tTree): BOOLEAN;
  89.    BEGIN
  90.       WHILE t^.Kind = Tree.Name DO
  91.      IF t^.Name.Name = i THEN RETURN TRUE; END;
  92.      t := t^.Name.Next;
  93.       END;
  94.       RETURN FALSE;
  95.    END LookUp;
  96.  
  97. PROCEDURE ProcessIgnore2 (t: tTree): tTree;
  98.    VAR r: tTree;
  99.    BEGIN
  100.       IF t^.Kind # Tree.NoAttribute THEN
  101.      t^.AttrOrAction.Next := ProcessIgnore2 (t^.AttrOrAction.Next);
  102.       END;
  103.       IF (t^.Kind = Tree.Child) AND (Ignore IN t^.Child.Properties) OR
  104.          (t^.Kind = Tree.Attribute) AND (Ignore IN t^.Attribute.Properties) OR
  105.          (t^.Kind = Tree.ActionPart) AND (Ignore IN t^.ActionPart.Properties) THEN
  106.      RETURN t^.AttrOrAction.Next;
  107.       END;
  108.       RETURN t;
  109.    END ProcessIgnore2;
  110.  
  111. PROCEDURE CompBaseClass (t, b: tTree);
  112.    BEGIN
  113.       IF t^.Kind = Tree.Class THEN
  114.      t^.Class.BaseClass := b;
  115.      CompBaseClass (t^.Class.Next, b);
  116.      CompBaseClass (t^.Class.Extensions, t);
  117.       END;
  118.    END CompBaseClass;
  119.  
  120. PROCEDURE CompParsIndex (t: tTree; VAR Index: SHORTCARD);
  121.    VAR OldIndex    : SHORTCARD;
  122.    BEGIN
  123.       OldIndex := Index;
  124.       CASE t^.Kind OF
  125.       | Tree.Class:
  126.      CompParsIndex (t^.Class.Attributes, Index);
  127.      CompParsIndex (t^.Class.Extensions, Index);
  128.      CompParsIndex (t^.Class.Next, OldIndex);
  129.       | Tree.Child:
  130.      INC (Index);
  131.      t^.Child.ParsIndex := Index;
  132.      CompParsIndex (t^.Child.Next, Index);
  133.       | Tree.Attribute:
  134.      CompParsIndex (t^.Attribute.Next, Index);
  135.       | Tree.ActionPart:
  136.      INC (Index);
  137.      t^.ActionPart.ParsIndex := Index;
  138.      INC (ActionCount);
  139.      t^.ActionPart.Name := ActionCount;
  140.      CompParsIndex (t^.ActionPart.Next, Index);
  141.       ELSE
  142.       END;
  143.    END CompParsIndex;
  144.  
  145. PROCEDURE CompIndex (t: tTree; In: SHORTCARD; VAR Out: SHORTCARD);
  146.    BEGIN
  147.       CASE t^.Kind OF
  148.       | Tree.Class:
  149.      CompIndex (t^.Class.Attributes, In, Out);
  150.      t^.Class.AttrCount := Out;
  151.      CompIndex (t^.Class.Extensions, Out, Out);
  152.      CompIndex (t^.Class.Next, In, Out);
  153.       | Tree.NoClass:
  154.       | Tree.Child:
  155.      INC (In);
  156.      t^.Child.AttrIndex := In;
  157.      CompIndex (t^.Child.Next, In, Out);
  158.       | Tree.Attribute:
  159.      INC (In);
  160.      t^.Attribute.AttrIndex := In;
  161.      CompIndex (t^.Attribute.Next, In, Out);
  162.       | Tree.ActionPart:
  163.      CompIndex (t^.ActionPart.Next, In, Out);
  164.       | Tree.NoAttribute:
  165.      Out := In;
  166.       END;
  167.    END CompIndex;
  168.  
  169. PROCEDURE CompInstance (t: tTree; In: SHORTCARD; VAR Out: SHORTCARD);
  170.    BEGIN
  171.       CASE t^.Kind OF
  172.       | Tree.Class:
  173.      CompInstance (t^.Class.Attributes, In , Out);
  174.      t^.Class.InstCount := t^.Class.AttrCount + Out;
  175.      MaxInstCount := Max (MaxInstCount, t^.Class.InstCount);
  176.      CompInstance (t^.Class.Extensions, Out, Out);
  177.      CompInstance (t^.Class.Next, In, Out);
  178.       | Tree.NoClass:
  179.       | Tree.Child:
  180.      t^.Child.InstOffset := In;
  181.      IF t^.Child.Class # NoTree THEN
  182.         CompInstance (t^.Child.Next, In + t^.Child.Class^.Class.AttrCount, Out);
  183.      ELSE
  184.         CompInstance (t^.Child.Next, In, Out);
  185.      END;
  186.       | Tree.Attribute:
  187.      CompInstance (t^.Attribute.Next, In, Out);
  188.       | Tree.ActionPart:
  189.      CompInstance (t^.ActionPart.Next, In, Out);
  190.       | Tree.NoAttribute:
  191.      Out := In;
  192.       END;
  193.    END CompInstance;
  194.  
  195. PROCEDURE CompBitCount (t: tTree; In: SHORTCARD; VAR Out: SHORTCARD);
  196.    BEGIN
  197.       CASE t^.Kind OF
  198.       | Tree.Class:
  199.      CompBitCount (t^.Class.Attributes, In, Out);
  200.      t^.Class.BitCount := Out;
  201.      CompBitCount (t^.Class.Extensions, Out, Out);
  202.      CompBitCount (t^.Class.Next, In, Out);
  203.       | Tree.NoClass:
  204.       | Tree.Child:
  205.      IF {Input, Test, Dummy} * t^.Child.Properties = {} THEN INC (In); END;
  206.      CompBitCount (t^.Child.Next, In, Out);
  207.       | Tree.Attribute:
  208.      IF {Input, Test, Dummy} * t^.Attribute.Properties = {} THEN INC (In); END;
  209.      CompBitCount (t^.Attribute.Next, In, Out);
  210.       | Tree.ActionPart:
  211.      CompBitCount (t^.ActionPart.Next, In, Out);
  212.       | Tree.NoAttribute:
  213.      Out := In;
  214.       END;
  215.    END CompBitCount;
  216.  
  217. PROCEDURE CompBitOffset (t: tTree; In: SHORTCARD; VAR Out: SHORTCARD);
  218.    BEGIN
  219.       CASE t^.Kind OF
  220.       | Tree.Class:
  221.      CompBitOffset (t^.Class.Attributes, In , Out);
  222.      CompBitOffset (t^.Class.Extensions, Out, Out);
  223.      CompBitOffset (t^.Class.Next, In, Out);
  224.       | Tree.NoClass:
  225.       | Tree.Child:
  226.      t^.Child.BitOffset := In;
  227.      IF t^.Child.Class # NoTree THEN
  228.         CompBitOffset (t^.Child.Next, In + t^.Child.Class^.Class.BitCount, Out);
  229.      ELSE
  230.         CompBitOffset (t^.Child.Next, In, Out);
  231.      END;
  232.       | Tree.Attribute:
  233.      CompBitOffset (t^.Attribute.Next, In, Out);
  234.       | Tree.ActionPart:
  235.      CompBitOffset (t^.ActionPart.Next, In, Out);
  236.       | Tree.NoAttribute:
  237.      Out := In;
  238.       END;
  239.    END CompBitOffset;
  240.  
  241. PROCEDURE InitInstance (t: tTree; Offset: SHORTCARD; InstancePtr: tInstancePtr);
  242.    BEGIN
  243.       CASE t^.Kind OF
  244.       | Tree.Class:
  245.      InitInstance (t^.Class.BaseClass , Offset, InstancePtr);
  246.      InitInstance (t^.Class.Attributes, Offset, InstancePtr);
  247.       | Tree.NoClass:
  248.       | Tree.Child:
  249.      WITH InstancePtr^ [t^.Child.AttrIndex] DO
  250.         Attribute  := t;
  251.         Properties := t^.Child.Properties + {Left};
  252.         Action     := ADR (Action);
  253.      END;
  254.      IF t^.Child.Class # NoTree THEN
  255.         InitInstance1 (t^.Child.Class, t, Offset + t^.Child.InstOffset, InstancePtr);
  256.      END;
  257.      InitInstance (t^.Child.Next, Offset, InstancePtr);
  258.       | Tree.Attribute:
  259.      WITH InstancePtr^ [t^.Attribute.AttrIndex] DO
  260.         Attribute  := t;
  261.         Properties := t^.Attribute.Properties + {Left};
  262.         Action     := ADR (Action);
  263.      END;
  264.      InitInstance (t^.Attribute.Next, Offset, InstancePtr);
  265.       | Tree.ActionPart:
  266.      InitInstance (t^.ActionPart.Next, Offset, InstancePtr);
  267.       | Tree.NoAttribute:
  268.       END;
  269.    END InitInstance;
  270.  
  271. PROCEDURE InitInstance1 (t, selector: tTree; Offset: SHORTCARD; InstancePtr: tInstancePtr);
  272.    BEGIN
  273.       CASE t^.Kind OF
  274.       | Tree.Class:
  275.      InitInstance1 (t^.Class.BaseClass , selector, Offset, InstancePtr);
  276.      InitInstance1 (t^.Class.Attributes, selector, Offset, InstancePtr);
  277.       | Tree.NoClass:
  278.       | Tree.Child:
  279.      WITH InstancePtr^ [Offset + t^.Child.AttrIndex] DO
  280.         Selector   := selector;
  281.         Attribute  := t;
  282.         Properties := t^.Child.Properties + {Right};
  283.         Action     := ADR (Action);
  284.      END;
  285.      InitInstance1 (t^.Child.Next, selector, Offset, InstancePtr);
  286.       | Tree.Attribute:
  287.      WITH InstancePtr^ [Offset + t^.Attribute.AttrIndex] DO
  288.         Selector   := selector;
  289.         Attribute  := t;
  290.         Properties := t^.Attribute.Properties + {Right};
  291.         Action     := ADR (Action);
  292.      END;
  293.      InitInstance1 (t^.Attribute.Next, selector, Offset, InstancePtr);
  294.       | Tree.ActionPart:
  295.      InitInstance1 (t^.ActionPart.Next, selector, Offset, InstancePtr);
  296.       | Tree.NoAttribute:
  297.       END;
  298.    END InitInstance1;
  299.  
  300. VAR relation    : tRelation;
  301. VAR result    : INTEGER;
  302.  
  303. PROCEDURE EnterDependency (argument: CARDINAL);
  304.    BEGIN
  305.       Relations.Include (relation, result, argument);
  306.    END EnterDependency;
  307.  
  308. VAR MultipleInheritedActions    : BOOLEAN;
  309.  
  310. PROCEDURE CompDP1 (t: tTree; VAR Set: tSet; Usage: INTEGER; NonBase, Check: BOOLEAN);
  311.    VAR Attribute, ChildsClass    : tTree;
  312.    VAR Offset    : SHORTCARD;
  313.    BEGIN
  314.       CASE t^.Kind OF
  315.       | Tree.Class:
  316.         CompDP1 (t^.Class.BaseClass , Set, Usage, FALSE  , Check);
  317.         MultipleInheritedActions := FALSE;
  318.         CompDP1 (t^.Class.Attributes, Set, Usage, NonBase, Check);
  319.       | Tree.NoClass:
  320.       | Tree.Attribute:
  321.         IF t^.Attribute.AttrIndex # DummyIndex THEN        (* HAGs *)
  322.            Relations.Include (relation, DummyIndex, t^.Attribute.AttrIndex);
  323.         END;
  324.         CompDP1 (t^.Attribute.Next, Set, Usage, NonBase, Check);
  325.       | Tree.Child:
  326.         ChildsClass := t^.Child.Class;
  327.         IF ChildsClass # NoTree THEN
  328.            IF NOT (Input IN t^.Child.Properties) THEN    (* HAGs *)
  329.           Relations.Include (relation, DummyIndex, t^.Child.AttrIndex);
  330.           FOR i := 1 TO ChildsClass^.Class.AttrCount DO
  331.              Relations.Include (relation, Class^.Class.AttrCount + t^.Child.InstOffset + i, t^.Child.AttrIndex);
  332.           END;
  333.            END;
  334.  
  335.            Attribute := IdentifyAttribute (ChildsClass, iNull);
  336.            Offset := Class^.Class.AttrCount + t^.Child.InstOffset + Attribute^.Child.AttrIndex;
  337.            Relations.Include (relation, DummyIndex, Offset);
  338.            INCL (Class^.Class.Instance^[Offset].Properties, Right);
  339.         END;
  340.         CompDP1 (t^.Child.Next, Set, Usage, NonBase, Check);
  341.       | Tree.ActionPart:
  342.         IF MultInhComp IN t^.ActionPart.Properties THEN MultipleInheritedActions := TRUE; END;
  343.         CompDP1 (t^.ActionPart.Actions, Set, Usage, NonBase, Check);
  344.         CompDP1 (t^.ActionPart.Next   , Set, Usage, NonBase, Check);
  345.       | Tree.NoAttribute:
  346.       | Tree. Assign :
  347.         IF IsCopy (t^.Assign.Arguments) THEN t^.Kind := Tree.Copy; END;
  348.         AssignEmpty (Results  );
  349.         AssignEmpty (Arguments);
  350.         CompDP1 (t^.Assign.Results  , Results  , Write, NonBase, TRUE );
  351.         CompDP1 (t^.Assign.Arguments, Arguments, Read , NonBase, FALSE);
  352.         IF IsEmpty (Results) THEN
  353.            ? AssignmentWithIncorrectLeftHandSide E ?
  354.         END;
  355.         WHILE NOT IsEmpty (Results) DO
  356.            result := Extract (Results);
  357.            WITH Class^.Class.Instance^[result] DO
  358.           IF (Action = ADR (Action)) OR (MultInhComp IN Properties) OR NOT MultipleInheritedActions THEN
  359.              Action := t;
  360.              IF t^.Kind = Tree.Copy THEN CopyArg := Select (Arguments); END;
  361.           END;
  362.            END;
  363.            ForallDo (Arguments, EnterDependency);
  364.         END;
  365.         CompDP1 (t^.Assign.Next, Set, Usage, NonBase, Check);
  366.       | Tree. Copy :
  367.         AssignEmpty (Results  );
  368.         AssignEmpty (Arguments);
  369.         CompDP1 (t^.Copy.Results  , Results  , Write, NonBase, TRUE );
  370.         CompDP1 (t^.Copy.Arguments, Arguments, Read , NonBase, TRUE );
  371.         IF IsEmpty (Results) THEN
  372.            ? CopyRuleWithIncorrectLeftHandSide E ?
  373.         END;
  374.         WHILE NOT IsEmpty (Results) DO
  375.            result := Extract (Results);
  376.            WITH Class^.Class.Instance^[result] DO
  377.           IF (Action = ADR (Action)) OR (MultInhComp IN Properties) OR NOT MultipleInheritedActions THEN
  378.              Action  := t;
  379.              CopyArg := Select (Arguments);
  380.           END;
  381.            END;
  382.            ForallDo (Arguments, EnterDependency);
  383.         END;
  384.         CompDP1 (t^.Copy.Next, Set, Usage, NonBase, Check);
  385.       | Tree. TargetCode :
  386.         AssignEmpty (Results  );
  387.         AssignEmpty (Arguments);
  388.         CompDP1 (t^.TargetCode.Results, Results  , Write, NonBase, TRUE );
  389.         CompDP1 (t^.TargetCode.Code   , Arguments, Read , NonBase, FALSE);
  390.         Difference (Arguments, Results);
  391.         IF IsEmpty (Results) AND IsCode (t^.TargetCode.Code) THEN
  392.            ? BlockWithIncorrectLeftHandSide E ?
  393.         END;
  394.         WHILE NOT IsEmpty (Results) DO
  395.            result := Extract (Results);
  396.            WITH Class^.Class.Instance^[result] DO
  397.           IF (Action = ADR (Action)) OR (MultInhComp IN Properties) OR NOT MultipleInheritedActions THEN
  398.              Action  := t;
  399.           END;
  400.            END;
  401.            ForallDo (Arguments, EnterDependency);
  402.         END;
  403.         CompDP1 (t^.TargetCode.Next, Set, Usage, NonBase, Check);
  404.       | Tree. Order:
  405.         AssignEmpty (Results  );
  406.         AssignEmpty (Arguments);
  407.         CompDP1 (t^.Order.Results  , Results  , Read, NonBase, TRUE );
  408.         CompDP1 (t^.Order.Arguments, Arguments, Read, NonBase, TRUE );
  409.         WHILE NOT IsEmpty (Results) DO
  410.            result := Extract (Results);
  411.            ForallDo (Arguments, EnterDependency);
  412.         END;
  413.         CompDP1 (t^.Order.Next, Set, Usage, NonBase, Check);
  414.       | Tree. Check :
  415.         IF t^.Check.Results # NoTree THEN
  416.            AssignEmpty (Results  );
  417.            AssignEmpty (Arguments);
  418.            CompDP1 (t^.Check.Results, Results, Write, NonBase, FALSE);
  419.         END;
  420.         IF t^.Check.Condition # NoTree THEN
  421.            CompDP1 (t^.Check.Condition, Arguments, Read, NonBase, FALSE);
  422.         END;
  423.         IF t^.Check.Statement # NoTree THEN
  424.            CompDP1 (t^.Check.Statement, Arguments, Read, NonBase, FALSE);
  425.         ELSE
  426.            ? CheckWithoutStatement W ?
  427.         END;
  428.         CompDP1 (t^.Check.Actions, Arguments, Read, NonBase, FALSE);
  429.         IF t^.Check.Results # NoTree THEN
  430.            result := Extract (Results);
  431.            Class^.Class.Instance^[result].Action := t;
  432.            ForallDo (Arguments, EnterDependency);
  433.            CompDP1 (t^.Check.Next, Set, Usage, NonBase, Check);
  434.         END;
  435.       | Tree.NoAction:
  436.       | Tree. Designator :
  437.         Attribute := IdentifyAttribute (Class, t^.Designator.Selector);
  438.         IF (Attribute # NoTree) AND (Attribute^.Kind = Tree.Child) THEN
  439.            ChildsClass := Attribute^.Child.Class;
  440.            Offset := Class^.Class.AttrCount + Attribute^.Child.InstOffset;
  441.            INCL (Attribute^.Child.Properties, Read);
  442.            IF ChildsClass # NoTree THEN
  443.           Attribute := IdentifyAttribute (ChildsClass, t^.Designator.Attribute);
  444.           IF Attribute # NoTree THEN
  445.              Include (Set, Offset + Attribute^.Child.AttrIndex);
  446.              INCL (Attribute^.Child.Properties, Usage);
  447.              IF Usage = Write THEN
  448.             INCL (Attribute^.Child.Properties, Inherited);
  449.             INCL (Class^.Class.Instance^ [Offset + Attribute^.Child.AttrIndex].Properties, Computed);
  450.             IF Synthesized IN Attribute^.Child.Properties THEN
  451.                ? InheritedUseOfSynthesizedAttribute E Ident t^.Designator.Attribute ?
  452.             END;
  453.             WITH Class^.Class.Instance^ [Offset + Attribute^.Child.AttrIndex] DO
  454.                IF NonBase AND NOT MultipleInheritedActions AND (NonBaseComp IN Properties) AND
  455.                   NOT (MultInhComp IN Properties) THEN
  456.                   ? AttributeMultipleComputed E Ident t^.Designator.Attribute ?
  457.                END;
  458.                IF NOT MultipleInheritedActions OR (MultInhComp IN Properties) THEN
  459.                   EXCL (Properties, MultInhComp);
  460.                   IF NonBase THEN INCL (Properties, NonBaseComp); END;
  461.                   IF MultipleInheritedActions THEN INCL (Properties, MultInhComp); END;
  462.                END;
  463.             END;
  464.              END;
  465.           ELSIF Check THEN
  466.              ? AttributeNotDeclared E Ident t^.Designator.Attribute ?
  467.           END;
  468.            END;
  469.         ELSIF Check THEN
  470.            ? SelectorNotDeclared E Ident t^.Designator.Selector ?
  471.         END;
  472.         CompDP1 (t^.Designator.Next, Set, Usage, NonBase, Check);
  473.       | Tree. Ident :
  474.         Attribute := IdentifyAttribute (Class, t^.Ident.Attribute);
  475.         IF Attribute # NoTree THEN
  476.            Include (Set, Attribute^.Child.AttrIndex);
  477.            INCL (Attribute^.Child.Properties, Usage);
  478.            IF Usage = Write THEN
  479.           INCL (Attribute^.Child.Properties, Synthesized);
  480.           INCL (Class^.Class.Instance^ [Attribute^.Child.AttrIndex].Properties, Computed);
  481.           IF Inherited IN Attribute^.Child.Properties THEN
  482.              ? SynthesizedUseOfInheritedAttribute E Ident t^.Ident.Attribute ?
  483.           END;
  484.           WITH Class^.Class.Instance^ [Attribute^.Child.AttrIndex] DO
  485.              IF NonBase AND NOT MultipleInheritedActions AND (NonBaseComp IN Properties) AND
  486.             NOT (MultInhComp IN Properties) THEN
  487.             ? AttributeMultipleComputed E Ident t^.Ident.Attribute ?
  488.              END;
  489.              IF NOT MultipleInheritedActions OR (MultInhComp IN Properties) THEN
  490.             EXCL (Properties, MultInhComp);
  491.             IF NonBase THEN INCL (Properties, NonBaseComp); END;
  492.             IF MultipleInheritedActions THEN INCL (Properties, MultInhComp); END;
  493.              END;
  494.           END;
  495.            END;
  496.         ELSIF Check THEN
  497.            ? AttributeNotDeclared E Ident t^.Ident.Attribute ?
  498.         END;
  499.         CompDP1 (t^.Ident.Next, Set, Usage, NonBase, Check);
  500.       | Tree.Remote:
  501.         CompDP1 (t^.Remote.Designators, Set, Usage, NonBase, Check);
  502.         CompDP1 (t^.Remote.Next, Set, Usage, NonBase, Check);
  503.       | Tree.Any:
  504.         CompDP1 (t^.Any.Next, Set, Usage, NonBase, Check);
  505.       | Tree.Anys:
  506.         CompDP1 (t^.Anys.Next, Set, Usage, NonBase, Check);
  507.       | Tree.NoDesignator:
  508.       END;
  509.    END CompDP1;
  510.  
  511. PROCEDURE IsCode (t: tTree): BOOLEAN;
  512.    BEGIN
  513.       CASE t^.Kind OF
  514.       | Tree.Designator
  515.       , Tree.Ident
  516.       , Tree.Remote     : RETURN TRUE;
  517.       | Tree.Any     : RETURN IsCode (t^.Any.Next);
  518.       | Tree.Anys     : RETURN IsCode (t^.Anys.Next);
  519.       | Tree.NoDesignator: RETURN FALSE;
  520.       END;
  521.    END IsCode;
  522.  
  523. PROCEDURE CopyTree (t: tTree): tTree;
  524.    BEGIN
  525.       CASE t^.Kind OF
  526.       | Tree.Attribute: WITH t^.Attribute DO
  527.         RETURN mAttribute (CopyTree (Next), Name, Type, Properties, Pos);
  528.      END;
  529.       | Tree.Child: WITH t^.Child DO
  530.         RETURN mChild (CopyTree (Next), Name, Type, Properties, Pos);
  531.      END;
  532.       | Tree.ActionPart: WITH t^.ActionPart DO
  533.         RETURN mActionPart (CopyTree (Next), Actions);
  534.      END;
  535.       | Tree.NoAttribute:
  536.      RETURN nNoAttribute;
  537.       END;
  538.    END CopyTree;
  539.  
  540. PROCEDURE ExpandMultiple (Class: tTree);
  541.    VAR Node, class: tTree;
  542.    BEGIN
  543.       WITH Class^.Class DO
  544.      IF NOT (Mark IN Properties) THEN
  545.         INCL (Properties, Mark);
  546.         IF BaseClass^.Kind = Tree.Class THEN ExpandMultiple (BaseClass); END;
  547.         Node := Names;
  548.         WHILE Node^.Kind = Tree.Name DO
  549.            WITH Node^.Name DO
  550.           class := IdentifyClass (TreeRoot^.Ag.Classes, Name);
  551.           IF class # NoTree THEN
  552.              ExpandMultiple (class);
  553.              TheClass := Class;
  554.              ForallAttributes (class, ExpandMultiple2);
  555.           END;
  556.           Node := Next;
  557.            END;
  558.         END;
  559.         EXCL (Properties, Mark);
  560.      END;
  561.       END;
  562. END ExpandMultiple;
  563.  
  564. PROCEDURE AppendAttr (VAR Attributes: tTree; Attribute: tTree);
  565.    BEGIN
  566.       IF Attributes^.Kind = NoAttribute THEN
  567.      Attribute^.AttrOrAction.Next := Attributes;
  568.      Attributes := Attribute;
  569.       ELSE
  570.      AppendAttr (Attributes^.AttrOrAction.Next, Attribute);
  571.       END;
  572.    END AppendAttr;
  573. }
  574.  
  575. BEGIN    {
  576.    ItemCount        := 0;
  577.    ChecksCount        := 0;
  578.    MaxInstCount        := 0;
  579.    CopyInherited    := 0;
  580.    CopySynthesized    := 0;
  581.    CopyThreaded        := 0;
  582.    IntToString (0, String); iNull := MakeIdent (String);
  583. }
  584.  
  585. PROCEDURE Semantics (t: Tree)
  586.  
  587. Ag (..) :- {
  588.     InitIdentifyClass (Classes);
  589.     ForallClasses (Classes, StampItems);
  590.     StampItems (Modules);
  591.     ExpandProps (Props);
  592.     ExpandProps (Modules);
  593.     IF Ignore IN Properties THEN
  594.        ProcessIgnore (ParserCodes);
  595.        ProcessIgnore (TreeCodes);
  596.        ProcessIgnore (EvalCodes);
  597.     END;
  598.     ProcessIgnore (Decls);
  599.     ForallClasses (Classes, ProcessIgnore);
  600.     ProcessIgnore (Modules);
  601.     ExpandModules (Decls);
  602.     ExpandModules (Modules);
  603.       IF IsElement (ORD ('c'), Options) THEN
  604.     ArrayToString ("bool", String);
  605.       ELSE
  606.     ArrayToString ("BOOLEAN", String);
  607.       END;
  608.     Ident := MakeIdent (String);
  609.     TypeCount := MaxIdent ();
  610.     MakeSet (TypeNames, TypeCount);
  611.     Include (TypeNames, Ident);
  612.     Semantics (Classes);
  613. }; .
  614. Class (..) :- {
  615.     CompBaseClass (t, nNoClass);            (* ast *)
  616.     ForallClasses (t, ExpandMultiple);
  617.     ClassCount := 0;
  618.     MakeSet (CodesUsed, MaxIdent ());
  619.     ForallClasses (t, CountClasses);
  620.     ForallClasses (t, CheckReverse);
  621.     INCL (t^.Class.Properties, Referenced);
  622.         CompReachable (t);
  623.  
  624.       IF IsElement (ORD ('x'), Options) OR
  625.      IsElement (ORD ('z'), Options) OR
  626.      IsElement (ORD ('u'), Options) THEN
  627.     TokenCode := 0;
  628.     ForallClasses (t, CodeTerminals);
  629.     ActionCount := 0;
  630.     i := 0;
  631.     CompParsIndex (t, i);
  632.     ForallClasses (t, CheckUsage2);
  633.       END;
  634.  
  635.     ForallClasses (t, ExpandChecks);
  636.     ForallClasses (t, Identify);
  637.     MakeSet (ClassNames, MaxIdent ());
  638.     MakeSet (SelectorNames, MaxIdent ());
  639.     MakeSet (VariantNames, MaxIdent ());
  640.     MakeSet (PrecNames, MaxIdent ());
  641.     CheckNames (TreeRoot^.Ag.Precs);
  642.     ForallClasses (t, CheckNames);
  643.     ReleaseSet (ClassNames);
  644.     ReleaseSet (SelectorNames);
  645.     ReleaseSet (VariantNames);
  646.     ReleaseSet (PrecNames);
  647.     ReleaseSet (CodesUsed);
  648.     ForallClasses (t, CheckDesignator);
  649.     CompBitCount (t, 1, i);
  650.     CompBitOffset (t, 0, i);
  651.  
  652.       IF IsElement (ORD ('.'), Options) THEN        (* ag *)
  653.     CompIndex (t, 0, i);
  654.     CompInstance (t, 0, i);
  655.     MakeSet (MaxSet, MaxInstCount);
  656.     Complement (MaxSet);
  657.         ForallClasses (t, InitInstance0);
  658.         ForallClasses (t, CompDP);
  659.       IF IsElement (ORD ('2'), Options) THEN
  660.     WriteNl (StdOutput);
  661.     WriteS (StdOutput, "Inherited Attribute Computation Rules"); WriteNl (StdOutput);
  662.     WriteS (StdOutput, "-------------------------------------"); WriteNl (StdOutput);
  663.     WriteNl (StdOutput);
  664.       END;
  665.         ForallClasses (t, CopyProperties);
  666.         ForallClasses (t, CheckInherited);
  667.       IF IsElement (ORD ('1'), Options) THEN
  668.     WriteNl (StdOutput);
  669.     WriteS (StdOutput, "Inserted Copy Rules"); WriteNl (StdOutput);
  670.     WriteS (StdOutput, "-------------------"); WriteNl (StdOutput);
  671.     WriteNl (StdOutput);
  672.       END;
  673.     Success := TRUE;
  674.         ForallClasses (t, CheckComplete);
  675.     IF Success THEN INCL (GrammarClass, cLNC); END;
  676.     IF CopyInherited > 0 THEN
  677.        ? CopyRuleInsertionsInherited I Integer CopyInherited ?
  678.     END;
  679.     IF CopySynthesized > 0 THEN
  680.        ? CopyRuleInsertionsSynthesized I Integer CopySynthesized ?
  681.     END;
  682.     IF CopyThreaded > 0 THEN
  683.        ? CopyRuleInsertionsThreaded I Integer CopyThreaded ?
  684.     END;
  685.         ForallClasses (t, CheckUsage);
  686.       END;
  687. }; .
  688.  
  689.  
  690. /* ast */
  691.  
  692. PROCEDURE StampItems (t: Tree)
  693.  
  694. Module (..) :- {
  695.     ForallClasses (Classes, StampItems);
  696.     StampItems (Next);
  697. }; .
  698. Class (..) :- {
  699.     IF Abstract IN Properties THEN
  700.        ForallAttributes (Attributes, StampItems);
  701.     END;
  702. }; .
  703. Child (..) :- {
  704.     INC (ItemCount); Item := ItemCount;
  705. }; .
  706. Attribute (..) :- {
  707.     INC (ItemCount); Item := ItemCount;
  708. }; .
  709. ActionPart (..) :- {
  710.     INC (ItemCount); Item := ItemCount;
  711. }; .
  712.  
  713.  
  714. PROCEDURE ExpandProps (t: Tree)
  715.  
  716. Module (..) :- {
  717.     ExpandProps (Props);
  718.     ExpandProps (Next);
  719. }; .
  720. Prop (..) :- {
  721.     ActProperties := Properties;
  722.     ExpandProps (Names);
  723.     ExpandProps (Next);
  724. }; .
  725. Select (..) :- {
  726.     CheckSelect (Names);
  727.     ActProperties := {Ignore};
  728.     IF NOT LookUp (TreeRoot^.Ag.Name, Names) THEN
  729.        TreeRoot^.Ag.Properties := TreeRoot^.Ag.Properties + ActProperties;
  730.        ExpandProps (TreeRoot^.Ag.Decls);
  731.        ForallClasses (TreeRoot^.Ag.Classes, ExpandProps);
  732.     END;
  733.     Module := TreeRoot^.Ag.Modules;
  734.     WHILE Module^.Kind = Tree.Module DO
  735.        IF NOT LookUp (Module^.Module.Name, Names) THEN
  736.           Module^.Module.Properties := Module^.Module.Properties + ActProperties;
  737.           ExpandProps (Module^.Module.Decls);
  738.           ForallClasses (Module^.Module.Classes, ExpandProps);
  739.        END;
  740.        Module := Module^.Module.Next;
  741.     END;
  742.     ExpandProps (Next);
  743. }; .
  744. Name (..) :- {
  745.     IF Name = TreeRoot^.Ag.Name THEN
  746.        TreeRoot^.Ag.Properties := TreeRoot^.Ag.Properties + ActProperties;
  747.        ExpandProps (TreeRoot^.Ag.Decls);
  748.        ForallClasses (TreeRoot^.Ag.Classes, ExpandProps);
  749.     ELSE
  750.        Module := IdentifyModule (TreeRoot^.Ag.Modules, Name);
  751.        IF Module = NoTree THEN
  752.           ? ModuleNotDeclared W Ident Name ?
  753.        ELSE
  754.           Module^.Module.Properties := Module^.Module.Properties + ActProperties;
  755.           ExpandProps (Module^.Module.Decls);
  756.           ForallClasses (Module^.Module.Classes, ExpandProps);
  757.        END;
  758.     END;
  759.     ExpandProps (Next);
  760. }; .
  761. Decl (..) :- {
  762.     ForallAttributes (Attributes, ExpandProps);
  763.     ExpandProps (Next);
  764. }; .
  765. Class (..) :- {
  766.     Properties := Properties + ActProperties;
  767.     ForallAttributes (Attributes, ExpandProps);
  768. }; .
  769. Child (..) :- {
  770.     Properties := Properties + ActProperties;
  771. }; .
  772. Attribute (..) :- {
  773.     Properties := Properties + ActProperties;
  774. }; .
  775. ActionPart (..) :- {
  776.     Properties := Properties + ActProperties;
  777. }; .
  778.  
  779.  
  780. PROCEDURE CheckSelect (t: Names)
  781.  
  782. Name (..) :- {
  783.     IF NOT ((Name = TreeRoot^.Ag.Name) OR (IdentifyModule (TreeRoot^.Ag.Modules, Name) # NoTree)) THEN
  784.        ? ModuleNotDeclared W Ident Name ?
  785.     END;
  786.     CheckSelect (Next);
  787. }; .
  788.  
  789.  
  790. PROCEDURE ProcessIgnore (t: Tree)
  791.  
  792. Module (..) :- {
  793.     IF Ignore IN Properties THEN
  794.        ProcessIgnore (ParserCodes);
  795.        ProcessIgnore (TreeCodes);
  796.        ProcessIgnore (EvalCodes);
  797.     END;
  798.     ProcessIgnore (Decls);
  799.     ForallClasses (Classes, ProcessIgnore);
  800.     ProcessIgnore (Next);
  801. }; .
  802. Codes (..) :- {
  803.     MakeText (Export);
  804.     MakeText (Import);
  805.     MakeText (Global);
  806.         MakeText (Local);
  807.     MakeText (Begin);
  808.     MakeText (Close);
  809. }; .
  810. Decl (..) :- {
  811.     Attributes := ProcessIgnore2 (Attributes);
  812.     ProcessIgnore (Next);
  813. }; .
  814. Class (..) :- {
  815.     Attributes := ProcessIgnore2 (Attributes);
  816.     IF Ignore IN Properties THEN Names := nNoName; END;
  817. }; .
  818.  
  819.  
  820. PROCEDURE ExpandModules (t: Tree)
  821.  
  822. Module (..) :- {
  823.     ExpandModules (Decls);
  824.     ExpandModules (Classes);
  825.     ExpandModules (Next);
  826. }; .
  827. Decl (..) :- {
  828.     Attribute    := Attributes;
  829.     ActProperties    := Properties;
  830.     ExpandModules (Names);
  831.     ExpandModules (Next);
  832. }; .
  833. Name (..) :- {
  834.     Class := IdentifyClass (TreeRoot^.Ag.Classes, Name);
  835.     IF Class = NoTree THEN
  836.        IF TreeRoot^.Ag.Classes^.Kind = Tree.NoClass THEN
  837.           TreeRoot^.Ag.Classes := mClass (Name, ActProperties, CopyTree (Attribute),
  838.          nNoClass, TreeRoot^.Ag.Classes, Name, Pos, 0, NoIdent, nNoName);
  839.           InitIdentifyClass2 (TreeRoot^.Ag.Classes);
  840.        ELSE
  841.           Node := TreeRoot^.Ag.Classes;
  842.           WHILE Node^.Class.Next^.Kind # Tree.NoClass DO
  843.          Node := Node^.Class.Next;
  844.           END;
  845.           Node^.Class.Next := mClass (Name, ActProperties, CopyTree (Attribute),
  846.          nNoClass, Node^.Class.Next, Name, Pos, 0, NoIdent, nNoName);
  847.           InitIdentifyClass2 (Node^.Class.Next);
  848.        END;
  849.     ELSE
  850.        IF Class^.Class.Attributes^.Kind = Tree.NoAttribute THEN
  851.           Class^.Class.Attributes := CopyTree (Attribute);
  852.        ELSE
  853.           Node := Class^.Class.Attributes;
  854.           WHILE Node^.Attribute.Next^.Kind # Tree.NoAttribute DO
  855.          Node := Node^.Attribute.Next;
  856.           END;
  857.           Node^.Attribute.Next := CopyTree (Attribute);
  858.        END;
  859.     END;
  860.     ExpandModules (Next);
  861. }; .
  862. Class (..) :- {
  863.     Class := IdentifyClass (TreeRoot^.Ag.Classes, Name);
  864.     ForallClasses (Extensions, InitIdentifyClass2);
  865.     IF Class = NoTree THEN
  866.        IF TreeRoot^.Ag.Classes^.Kind = Tree.NoClass THEN
  867.           TreeRoot^.Ag.Classes := mClass (Name, Properties, Attributes, Extensions,
  868.          TreeRoot^.Ag.Classes, Selector, Pos, Code, Prec, Names);
  869.           InitIdentifyClass2 (TreeRoot^.Ag.Classes);
  870.        ELSE
  871.           Node := TreeRoot^.Ag.Classes;
  872.           WHILE Node^.Class.Next^.Kind # Tree.NoClass DO
  873.          Node := Node^.Class.Next;
  874.           END;
  875.           Node^.Class.Next := mClass (Name, Properties, Attributes, Extensions,
  876.          Node^.Class.Next, Selector, Pos, Code, Prec, Names);
  877.           InitIdentifyClass2 (Node^.Class.Next);
  878.        END;
  879.     ELSE
  880.        IF Class^.Class.Attributes^.Kind = Tree.NoAttribute THEN
  881.           Class^.Class.Attributes := Attributes;
  882.        ELSE
  883.           Node := Class^.Class.Attributes;
  884.           WHILE Node^.Attribute.Next^.Kind # Tree.NoAttribute DO
  885.          Node := Node^.Attribute.Next;
  886.           END;
  887.           Node^.Attribute.Next := Attributes;
  888.        END;
  889.  
  890.        IF Class^.Class.Extensions^.Kind = Tree.NoClass THEN
  891.           Class^.Class.Extensions := Extensions;
  892.        ELSE
  893.           Node := Class^.Class.Extensions;
  894.           WHILE Node^.Class.Next^.Kind # Tree.NoClass DO
  895.          Node := Node^.Class.Next;
  896.           END;
  897.           Node^.Class.Next := Extensions;
  898.        END;
  899.  
  900.        IF Class^.Class.Names^.Kind = Tree.NoName THEN
  901.           Class^.Class.Names := Names;
  902.        ELSE
  903.           Node := Class^.Class.Names;
  904.           WHILE Node^.Name.Next^.Kind # Tree.NoName DO
  905.          Node := Node^.Name.Next;
  906.           END;
  907.           Node^.Name.Next := Names;
  908.        END;
  909.     END;
  910.     ExpandModules (Next);
  911. }; .
  912.  
  913.  
  914. PROCEDURE ExpandChecks (t: Tree)
  915.  
  916. Class (..) :- {
  917.     Class := t;
  918.     ExpandChecks (Attributes);
  919.     IF (BaseClass^.Kind = Tree.NoClass) THEN    (* Top ? *)
  920.        Attributes := mAttribute (Attributes, iNull, iNull, {Synthesized, Computed, Dummy}, NoPosition);
  921.     END;
  922. }; .
  923. Child (..) :- {
  924.     ExpandChecks (Next);
  925. }; .
  926. Attribute (..) :- {
  927.     ExpandChecks (Next);
  928. }; .
  929. ActionPart (..) :- {
  930.     ExpandChecks (Actions);
  931.     ExpandChecks (Next);
  932. }; .
  933. Assign (..) :- {
  934.     ExpandChecks (Next);
  935. }; .
  936. Copy (..) :- {
  937.     ExpandChecks (Next);
  938. }; .
  939. TargetCode (..) :- {
  940.     ExpandChecks (Next);
  941. }; .
  942. Order (..) :- {
  943.     ExpandChecks (Next);
  944. }; .
  945. Check (..) :- {
  946.     IF Results = NoTree THEN
  947.        INC (ChecksCount);
  948.        IntToString (ChecksCount, String);
  949.        Ident := MakeIdent (String);
  950.        Class^.Class.Attributes := mAttribute (Class^.Class.Attributes, Ident, Ident,
  951.           {Test}, NoPosition);
  952.        Results := mIdent (Ident, NoPosition, nNoDesignator);
  953.     ELSE
  954.        Class^.Class.Attributes := mAttribute (Class^.Class.Attributes,
  955.           Results^.Ident.Attribute, Results^.Ident.Attribute, {Test}, NoPosition);
  956.     END;
  957.     ExpandChecks (Next);
  958. }; .
  959.  
  960.  
  961. PROCEDURE ExpandMultiple2 (t: Tree)
  962.  
  963. Child (..) :- {
  964.     IF NOT HasItem (TheClass, Item) THEN
  965.        Node := mChild (NoTree, Name, Type, Properties, Pos);
  966.        Node^.AttrOrAction.Item := Item;
  967.        AppendAttr (TheClass^.Class.Attributes, Node);
  968.     END;
  969. }; .
  970. Attribute (..) :- {
  971.     IF NOT HasItem (TheClass, Item) THEN
  972.        Node := mAttribute (NoTree, Name, Type, Properties, Pos);
  973.        Node^.AttrOrAction.Item := Item;
  974.        AppendAttr (TheClass^.Class.Attributes, Node);
  975.     END;
  976. }; .
  977. ActionPart (..) :- {
  978.     IF NOT HasItem (TheClass, Item) THEN
  979.        Node := mActionPart (NoTree, Actions);
  980.        Node^.AttrOrAction.Item := Item;
  981.        INCL (Node^.ActionPart.Properties, MultInhComp);
  982.        AppendAttr (TheClass^.Class.Attributes, Node);
  983.     END;
  984. }; .
  985.  
  986.  
  987. PROCEDURE CountClasses (t: Tree)
  988.  
  989. Class (..) :- {
  990.     IF NOT (Abstract IN Properties) THEN INC (ClassCount); END;
  991.     ChildCount    := 0;
  992.     AttributeCount    := 0;
  993.     ActionCount    := 0;
  994.     Class := t;
  995.     ForallAttributes (t, CountClasses);
  996.     IF ChildCount      > 0 THEN INCL (t^.Class.Properties, HasChildren    ); END;
  997.     IF AttributeCount > 0 THEN INCL (t^.Class.Properties, HasAttributes    ); END;
  998.     IF ActionCount      > 0 THEN INCL (t^.Class.Properties, HasActions    ); END;
  999.     IF (Terminal IN Properties) AND (Code # 0) THEN
  1000.        IF IsElement (Code, CodesUsed) THEN
  1001.           ? TerminalCodeMultipleUsed E Integer Code ?
  1002.        END;
  1003.        Include (CodesUsed, Code);
  1004.     END;
  1005. }; .
  1006. Child (..) :- {
  1007.     INC (ChildCount);
  1008. }; .
  1009. Attribute (..) :- {
  1010.     IF (NoCodeAttr * Properties) = {} THEN 
  1011.        Include (TypeNames, Type);
  1012.        IF (Nonterminal IN Class^.Class.Properties) OR (Name # iPosition) THEN
  1013.           INC (AttributeCount);
  1014.        END;
  1015.     END;
  1016. }; .
  1017. ActionPart (..) :- {
  1018.     INC (ActionCount);
  1019. }; .
  1020.  
  1021.  
  1022. PROCEDURE CompReachable (t: Tree)
  1023.  
  1024. Class (..) :-
  1025.     NOT (Reachable IN Properties);
  1026.     INCL (Properties, Reachable);
  1027.     ForallAttributes (Attributes, CompReachable);
  1028.     ForallClasses (Extensions, CompReachable);
  1029.     .
  1030. Child (..) :- {
  1031.     Class := IdentifyClass (TreeRoot^.Ag.Classes, Type);
  1032.     IF Class # NoTree THEN
  1033.        INCL (Class^.Class.Properties, Referenced);
  1034.        CompReachable (Class);
  1035.     ELSE
  1036.       IF NOT IsElement (ORD ('j'), Options) THEN
  1037.        ? NodeTypeNotDeclared W Ident Type ?
  1038.       END;
  1039.        IF TreeRoot^.Ag.Classes^.Kind = Tree.NoClass THEN
  1040.           TreeRoot^.Ag.Classes := mClass (Type, {Terminal, Implicit, Reachable, Referenced},
  1041.          nNoAttribute, nNoClass, TreeRoot^.Ag.Classes, Type, Pos, 0, NoIdent, nNoName);
  1042.           InitIdentifyClass2 (TreeRoot^.Ag.Classes);
  1043.           TreeRoot^.Ag.Classes^.Class.BaseClass := nNoClass;
  1044.           Class := TreeRoot^.Ag.Classes;
  1045.        ELSE
  1046.           Node := TreeRoot^.Ag.Classes;
  1047.           WHILE Node^.Class.Next^.Kind # Tree.NoClass DO
  1048.          Node := Node^.Class.Next;
  1049.           END;
  1050.           Node^.Class.Next := mClass (Type, {Terminal, Implicit, Reachable, Referenced},
  1051.          nNoAttribute, nNoClass, Node^.Class.Next, Type, Pos, 0, NoIdent, nNoName);
  1052.           InitIdentifyClass2 (Node^.Class.Next);
  1053.           Node^.Class.Next^.Class.BaseClass := nNoClass;
  1054.           Class := Node^.Class.Next;
  1055.        END;
  1056.        INC (ClassCount);
  1057.     END;
  1058. }; .
  1059.  
  1060.  
  1061. PROCEDURE CodeTerminals (t: Tree)
  1062.  
  1063. Class (..) :- {
  1064.     IF ({Terminal, Referenced} <= Properties) AND (Code = 0) THEN
  1065.        REPEAT INC (TokenCode); UNTIL NOT IsElement (TokenCode, CodesUsed);
  1066.        Code := TokenCode;
  1067.     END;
  1068.     IF (Terminal IN Properties) AND (BaseClass^.Kind = Tree.NoClass) THEN    (* Top ? *)
  1069.        Attributes := mAttribute (Attributes, iPosition, itPosition, {Synthesized, Computed, Input, Read}, NoPosition);
  1070.     END;
  1071. }; .
  1072.  
  1073.  
  1074. PROCEDURE CheckReverse (t: Tree)
  1075.  
  1076. Class (..) :- {
  1077.     IF Extensions^.Kind = Tree.NoClass THEN        (* Low ? *)
  1078.        ReverseCount := 0;
  1079.        ForallAttributes (t, CheckReverse);
  1080.     END;
  1081. }; .
  1082. Child (..) :- {
  1083.      IF Reverse IN Properties THEN
  1084.         INC (ReverseCount);
  1085.         IF ReverseCount > 1 THEN
  1086.            ? OnlyOneReverseInNodeType E ?
  1087.         END;
  1088.      END;
  1089. }; .
  1090.  
  1091.  
  1092. PROCEDURE CheckNames (t: Tree)
  1093.  
  1094. Class (..) :- {
  1095.     IF IsElement (Name, ClassNames) THEN
  1096.        ? NodeTypeMultipleDeclared E Ident Name ?
  1097.     END;
  1098.     Include (ClassNames, Name);
  1099.     IF Terminal IN Properties THEN
  1100.        IF IsElement (Selector, VariantNames) THEN
  1101.           ? VariantSelectorMultipleDeclared E Ident Selector ?
  1102.        END;
  1103.        Include (VariantNames, Selector);
  1104.     END;
  1105.     IF (Prec # NoIdent) AND NOT IsElement (Prec, PrecNames) THEN
  1106.        ? PrecedenceNotDeclared E Ident Prec ?
  1107.     END;
  1108.     IF Extensions^.Kind = Tree.NoClass THEN        (* Low ? *)
  1109.        AssignEmpty (SelectorNames);
  1110.        ForallAttributes (t, CheckNames);
  1111.     END;
  1112.     CheckNames2 (Names);
  1113. }; .
  1114. Child (..) :- {
  1115.     IF IsElement (Name, SelectorNames) THEN
  1116.        IF NOT (IsElement (ORD ('x'), Options) OR
  1117.            IsElement (ORD ('z'), Options) OR
  1118.            IsElement (ORD ('u'), Options)) THEN
  1119.           ? SelectorMultipleDeclared E Ident Name ?
  1120.        END;
  1121.     END;
  1122.     Include (SelectorNames, Name);
  1123. }; .
  1124. Attribute (..) :- {
  1125.     IF IsElement (Name, SelectorNames) THEN
  1126.        ? SelectorMultipleDeclared E Ident Name ?
  1127.     END;
  1128.     Include (SelectorNames, Name);
  1129. }; .
  1130. LeftAssoc (..) :- {
  1131.     CheckNames (Names);
  1132.     CheckNames (Next);
  1133. }; .
  1134. RightAssoc (..) :- {
  1135.     CheckNames (Names);
  1136.     CheckNames (Next);
  1137. }; .
  1138. NonAssoc (..) :- {
  1139.     CheckNames (Names);
  1140.     CheckNames (Next);
  1141. }; .
  1142. Name (..) :- {
  1143.     IF IsElement (Name, PrecNames) THEN
  1144.        ? PrecedenceMultipleDeclared E Ident Name ?
  1145.     END;
  1146.     Include (PrecNames, Name);
  1147.     CheckNames (Next);
  1148. }; .
  1149.  
  1150.  
  1151. PROCEDURE CheckNames2 (t: Tree)
  1152.  
  1153. Name (..) :- {
  1154.     Class := IdentifyClass (TreeRoot^.Ag.Classes, Name);
  1155.     IF Class = NoTree THEN
  1156.        ? NodeTypeNotDeclared E Ident Name ?
  1157.     ELSE
  1158.        IF NOT (Abstract IN Class^.Class.Properties) THEN
  1159.           ? AbstractTypeRequired E ?
  1160.        END;
  1161.     END;
  1162.     CheckNames2 (Next);
  1163. }; .
  1164.  
  1165.  
  1166. PROCEDURE CheckDesignator (t: Tree)
  1167.  
  1168. Class (..) :- {
  1169.     Class := t;
  1170.     ForallAttributes (Attributes, CheckDesignator);
  1171. }; .
  1172. ActionPart (..) :- {
  1173.     CheckDesignator (Actions);
  1174. }; .
  1175. Assign (..) :- {
  1176.     CheckDesignator (Results);
  1177.     CheckDesignator (Arguments);
  1178.     CheckDesignator (Next);
  1179. }; .
  1180. Copy (..) :- {
  1181.     CheckDesignator (Results);
  1182.     CheckDesignator (Arguments);
  1183.     CheckDesignator (Next);
  1184. }; .
  1185. TargetCode (..) :- {
  1186.     CheckDesignator (Code);
  1187.     CheckDesignator (Next);
  1188. }; .
  1189. Check (..) :- {
  1190.     CheckDesignator (Statement);
  1191.     CheckDesignator (Condition);
  1192.     CheckDesignator (Actions);
  1193.     CheckDesignator (Next);
  1194. }; .
  1195. Designator (..) :- {
  1196.     Node := IdentifyAttribute (Class, Selector);
  1197.     IF Node # NoTree THEN
  1198.        IF Node^.Kind # Tree.Child THEN
  1199.           ? ChildRequired E ?
  1200.        ELSE
  1201.           IF Node^.Child.Class # NoTree THEN
  1202.          Node := IdentifyAttribute (Node^.Child.Class, Attribute);
  1203.          IF Node = NoTree THEN
  1204.             ? AttributeNotDeclared E Ident Attribute ?
  1205.          END;
  1206.           END;
  1207.        END;
  1208.     ELSE
  1209.        ? SelectorNotDeclared E Ident Selector ?
  1210.     END;
  1211.     CheckDesignator (Next);
  1212. }; .
  1213. Remote (..) :- {
  1214.    Node := IdentifyClass (TreeRoot^.Ag.Classes, Type);
  1215.    IF Node = NoTree THEN
  1216.       ? NodeTypeNotDeclared E Ident Type ?
  1217.    ELSE
  1218.       Node := IdentifyAttribute (Node, Attribute);
  1219.       IF Node = NoTree THEN
  1220.      ? AttributeNotDeclared E Ident Attribute ?
  1221.       END;
  1222.    END;
  1223. };
  1224.    CheckDesignator (Designators);
  1225.    CheckDesignator (Next);
  1226.    .
  1227. Order (..) ;
  1228. Ident (..) ;
  1229. Any (..) ;
  1230. Anys (..) ;
  1231. LayoutAny (..) :- CheckDesignator (Next); .
  1232.  
  1233.  
  1234. /* ag */
  1235.  
  1236. PROCEDURE Identify (t: Tree)
  1237.  
  1238. Class (..) :- {
  1239.     ForallAttributes (t, Identify);
  1240. }; .
  1241. Child (..) :- {
  1242.     Class := IdentifyClass (TreeRoot^.Ag.Classes, Type);
  1243.     IF (Class = NoTree) AND NOT IsElement (ORD ('x'), Options) AND
  1244.                 NOT IsElement (ORD ('z'), Options) AND
  1245.                 NOT IsElement (ORD ('u'), Options) THEN
  1246.        ? NodeTypeNotDeclared E Ident Type ?
  1247.     END;
  1248. }; .
  1249.  
  1250.  
  1251. PROCEDURE InitInstance0 (t: Tree)
  1252.  
  1253. Class (..) :- {
  1254.     InstanceSize := InstCount;
  1255.     MakeArray (Instance, InstanceSize, TSIZE (tInstance));
  1256.     InitInstance (t, AttrCount, Instance);
  1257. }; .
  1258.  
  1259.  
  1260. PROCEDURE CompDP (t: Tree)
  1261.  
  1262. Class (..) :- {
  1263.     MakeRelation (DP, InstCount, InstCount);
  1264.     relation := DP;
  1265.     MakeSet (Results  , InstCount);
  1266.     MakeSet (Arguments, InstCount);
  1267.     Class := t;
  1268.     Attribute := IdentifyAttribute (t, iNull);
  1269.     DummyIndex := Attribute^.Attribute.AttrIndex;
  1270.     INCL (Instance^[DummyIndex].Properties, Left);
  1271.     CompDP1 (t, Results, Write, TRUE, TRUE);
  1272.     ReleaseSet (Results  );
  1273.     ReleaseSet (Arguments);
  1274. }; .
  1275.  
  1276.  
  1277. PROCEDURE CopyProperties (t: Tree)
  1278.  
  1279. Class (..) :- {
  1280.     FOR i := 1 TO InstCount DO
  1281.        WITH Instance^[i] DO
  1282.           Properties := Properties + Attribute^.Child.Properties;
  1283.           IF (Action # ADR (Action)) AND (Action^.Kind = Tree.Copy) THEN
  1284.          INCL (Properties, CopyDef);
  1285.          INCL (Instance^[CopyArg].Properties, CopyUse);
  1286.           END;
  1287.       IF IsElement (ORD ('2'), Options) THEN
  1288.           IF NOT (NonBaseComp IN Properties) AND (Action # ADR (Action)) AND
  1289.          (({Synthesized, Left} <= Properties) OR
  1290.          ({Inherited, Right} <= Properties)) THEN
  1291.          WriteIdent    (StdOutput, Name);
  1292.          WriteS         (StdOutput, "    = { ");
  1293.          WriteClass    (Action);
  1294.          WriteS         (StdOutput, " } .");
  1295.          WriteNl    (StdOutput);
  1296.           END;
  1297.       END;
  1298.        END;
  1299.     END;
  1300. }; .
  1301.  
  1302.  
  1303. PROCEDURE CheckUsage (t: Tree)
  1304.  
  1305. Class (..) :- {
  1306.     IF Extensions^.Kind = Tree.NoClass THEN        (* Low ? *)
  1307.        Class := t;
  1308.        IsAbstract := Abstract IN Properties;
  1309.        ForallAttributes (t, CheckUsage);
  1310.     END;
  1311. }; .
  1312. Child (..) :- {
  1313.       IF NOT IsElement (ORD ('W'), Options) AND NOT IsAbstract THEN
  1314.     IF NOT (Input IN Properties) AND NOT (Write IN Properties) THEN
  1315.        ? AttributeNeverSet W Ident Name ?
  1316.     END;
  1317.     IF NOT (Output IN Properties) AND NOT (Read IN Properties) AND
  1318.        NOT IsElement (ORD ('x'), Options) AND
  1319.        NOT IsElement (ORD ('z'), Options) AND
  1320.        NOT IsElement (ORD ('u'), Options) THEN
  1321.        ? AttributeNeverUsed W Ident Name ?
  1322.     END;
  1323.       END;
  1324.     IF ({Input, Write} <= Properties) AND ((Class = NoTree) OR
  1325.        (Class # NoTree) AND NOT (Terminal IN Class^.Class.Properties)) THEN
  1326.        ? InputAttributeIsSet E Ident Name ?
  1327.     END;
  1328.     IF {Synthesized, Inherited} <= Properties THEN
  1329.        ? AttributeSynthesizedAsWellAsInherited E Ident Name ?
  1330.     END;
  1331. }; .
  1332. Attribute (..) :-
  1333.     ({{Test, Dummy}} * Properties) = {{}};
  1334. {     IF NOT IsElement (ORD ('W'), Options) AND NOT IsAbstract THEN
  1335.     IF NOT (Input IN Properties) AND NOT (Write IN Properties) THEN
  1336.        ? AttributeNeverSet W Ident Name ?
  1337.     END;
  1338.     IF NOT (Output IN Properties) AND NOT (Read IN Properties) THEN
  1339.        ? AttributeNeverUsed W Ident Name ?
  1340.     END;
  1341.       END;
  1342.     IF ({Input, Write} <= Properties) AND ((Class = NoTree) OR
  1343.        (Class # NoTree) AND NOT (Terminal IN Class^.Class.Properties)) THEN
  1344.        ? InputAttributeIsSet E Ident Name ?
  1345.     END;
  1346.     IF {Synthesized, Inherited} <= Properties THEN
  1347.        ? AttributeSynthesizedAsWellAsInherited E Ident Name ?
  1348.     END;
  1349. }; .
  1350.  
  1351.  
  1352. PROCEDURE CheckUsage2 (t: Tree)
  1353.  
  1354. Class (..) :-
  1355.    NOT IsElement (ORD ('W'), Options);
  1356.    NOT (Reachable IN Properties);
  1357.    String: tString;
  1358.    GetString (Name, String);
  1359.    (Char (String, 1) # 'y') AND (Char (String, 2) # 'y');
  1360.    ? NodeTypeNotUsed W Ident Name ?
  1361.    .
  1362.  
  1363.  
  1364. PROCEDURE CheckInherited (t: Tree)
  1365.  
  1366. Class (..) :- {
  1367.     IF BaseClass^.Kind = Tree.Class THEN        (* NOT Top ? *)
  1368.        CheckInherited (Attributes);
  1369.     END;
  1370. }; .
  1371. Child (..) :- {
  1372.     IF Inherited IN Properties THEN
  1373.        ? InheritedAttributesOnlyInBaseClasses E Ident Name ?
  1374.     END;
  1375.     CheckInherited (Next);
  1376. }; .
  1377. Attribute (..) :- {
  1378.     IF Inherited IN Properties THEN
  1379.        ? InheritedAttributesOnlyInBaseClasses E Ident Name ?
  1380.     END;
  1381.     CheckInherited (Next);
  1382. }; .
  1383.  
  1384.  
  1385. PROCEDURE CheckComplete (t: Tree)
  1386.  
  1387. Class (..) :- {
  1388.     IF (Extensions^.Kind = Tree.NoClass) OR        (* Low ? *)
  1389.            NOT IsElement (ORD ('B'), Options) THEN
  1390.        FOR i := 1 TO InstCount DO
  1391.           WITH Instance^ [i] DO
  1392.          IF NOT (Computed IN Properties) AND
  1393.             ((Terminal IN t^.Class.Properties) AND (Attribute^.Kind = Tree.Attribute) OR
  1394.             ({Synthesized, Left} <= Properties) OR
  1395.             ({Inherited,  Right} <= Properties)) THEN
  1396.             CopyRule (t);
  1397.             IF j = 0 THEN
  1398.                GetString (Name, String);
  1399.                ArrayToString (" = ", String2);
  1400.                Concatenate (String, String2);
  1401.                IF Right IN Properties THEN
  1402.               GetString (Selector^.Child.Name, String2);
  1403.               Concatenate (String, String2);
  1404.               Append    (String, ':');
  1405.               GetString (Attribute^.Child.Name, String2);
  1406.               Concatenate (String, String2);
  1407.                ELSE
  1408.               GetString (Attribute^.Child.Name, String2);
  1409.               Concatenate (String, String2);
  1410.                END;
  1411.                ? AttributeComputationMissing E String String ?
  1412.             END;
  1413.          END;
  1414.           END;
  1415.        END;
  1416.     END;
  1417.  
  1418.       IF IsElement (ORD ('L'), Options) THEN
  1419.     FOR i := 1 TO AttrCount DO
  1420.        WITH Instance^ [i] DO
  1421.           IF NOT (Input IN Properties) AND (Attribute^.Kind = Tree.Child) THEN
  1422.          FOR j := 1 TO InstCount DO
  1423.             IF IsRelated (j, i, DP) THEN
  1424.                FOR k := 1 TO AttrCount DO
  1425.               IF IsRelated (k, j, DP) THEN
  1426.                  Relations.Include (DP, k, i);
  1427.               END;
  1428.                END;
  1429.             END;
  1430.          END;
  1431.           END;
  1432.        END;
  1433.     END;
  1434.       END;
  1435.  
  1436.     IF IsCyclic (DP) THEN
  1437.        ? CycleInLocalDependenciesDP E Ident Name ?
  1438.        WriteS (StdOutput, "Attribute Dependencies DP");
  1439.        WriteNl (StdOutput); WriteNl (StdOutput);
  1440.        WriteDependencies (t, DP, MaxSet);
  1441.        WriteS (StdOutput, "Cyclic Attributes");
  1442.        WriteNl (StdOutput); WriteNl (StdOutput);
  1443.        MakeSet (Cyclics, InstCount);
  1444.        GetCyclics (DP, Cyclics);
  1445.        WriteCyclics (t, Cyclics); WriteNl (StdOutput);
  1446.        ReleaseSet (Cyclics);
  1447.        Success := FALSE;
  1448.     END;
  1449.       IF IsElement (ORD ('M'), Options) THEN
  1450.     WriteClass (t); WriteNl (StdOutput);
  1451.       END;
  1452.       IF IsElement (ORD ('P'), Options) THEN
  1453.     WriteDependencies (t, DP, MaxSet);
  1454.       END;
  1455. }; .
  1456.  
  1457.  
  1458. PROCEDURE CopyRule (t: Tree)
  1459.  
  1460. Class (..) :- {
  1461.     WITH Instance^ [i] DO
  1462.        j := 0;
  1463.        IF i <= AttrCount THEN
  1464.           Ident := Attribute^.Attribute.Name;
  1465.           ForallAttributes (t, CopyRule2);
  1466.           IF j # 0 THEN
  1467.          INC (j, AttrCount + Child^.Child.InstOffset);
  1468.          Action := mCopy (nNoAction, NoPosition,
  1469.             mIdent (Ident, NoPosition, nNoDesignator),
  1470.             mDesignator (Instance ^[j].Selector^.Child.Name, Ident, NoPosition, nNoDesignator));
  1471.          INC (CopySynthesized);
  1472.           END;
  1473.           IF (j = 0) AND (Thread IN Properties) THEN
  1474.          j := i - 1;
  1475.          Action := mCopy (nNoAction, NoPosition,
  1476.             mIdent (Ident, NoPosition, nNoDesignator),
  1477.             mIdent (Instance^ [j].Attribute^.Attribute.Name, NoPosition, nNoDesignator));
  1478.          INC (CopyThreaded);
  1479.           END;
  1480.        ELSE
  1481.           IF (Thread IN Properties) AND (Selector^.Child.InstOffset > 0) THEN
  1482.          Ident := Instance^ [i+1].Attribute^.Attribute.Name;    (* Out companion *)
  1483.          j := i - 1;
  1484.          LOOP
  1485.             IF j <= AttrCount THEN j := 0; EXIT; END;
  1486.             IF Instance^ [j].Attribute^.Attribute.Name = Ident THEN
  1487.                Action := mCopy (nNoAction, NoPosition,
  1488.               mDesignator (Selector^.Child.Name, Attribute^.Attribute.Name, NoPosition, nNoDesignator),
  1489.               mDesignator (Instance^ [j].Selector^.Child.Name, Ident, NoPosition, nNoDesignator));
  1490.                INC (CopyThreaded);
  1491.                EXIT;
  1492.             END;
  1493.             DEC (j);
  1494.          END;
  1495.           END;
  1496.           IF j = 0 THEN
  1497.          Ident := Attribute^.Attribute.Name;
  1498.          ForallAttributes (t, CopyRule);
  1499.          IF j # 0 THEN
  1500.             Action := mCopy (nNoAction, NoPosition,
  1501.                mDesignator (Selector^.Child.Name, Ident, NoPosition, nNoDesignator),
  1502.                mIdent (Ident, NoPosition, nNoDesignator));
  1503.             INC (CopyInherited);
  1504.          END;
  1505.           END;
  1506.        END;
  1507.        IF j # 0 THEN
  1508.       IF IsElement (ORD ('1'), Options) THEN
  1509.           WriteIdent (StdOutput, Name);
  1510.           WriteS     (StdOutput, "    = { ");
  1511.           WriteClass (Action);
  1512.           WriteS     (StdOutput, " } .");
  1513.           WriteNl     (StdOutput);
  1514.       END;
  1515.           CopyArg := j;
  1516.           TheAction := Action;
  1517.           Relations.Include (DP, i, j);
  1518.           INCL (Properties, CopyDef);
  1519.           INCL (Instance^[CopyArg].Properties, CopyUse);
  1520.           INCL (Properties, Write);
  1521.           INCL (Properties, Computed);
  1522.           INCL (Instance^[CopyArg].Properties, Read);
  1523.           INCL (Attribute^.Attribute.Properties, Write);
  1524.           INCL (Attribute^.Attribute.Properties, Computed);
  1525.           INCL (Instance^[CopyArg].Attribute^.Attribute.Properties, Read);
  1526.           IF Right IN Properties THEN
  1527.          INCL (Selector^.Child.Properties, Read);
  1528.           END;
  1529.           IF Right IN Instance^[CopyArg].Properties THEN
  1530.          INCL (Instance^[CopyArg].Selector^.Child.Properties, Read);
  1531.           END;
  1532.        END;
  1533.     END;
  1534.     IF j # 0 THEN                (* update abstract syntax *)
  1535.        INCL (Properties, HasActions);
  1536.        IF Attributes^.Kind = Tree.NoAttribute THEN
  1537.           Attributes := mActionPart (Attributes, TheAction);
  1538.        ELSE
  1539.           Node := Attributes;
  1540.           WHILE Node^.AttrOrAction.Next^.Kind # Tree.NoAttribute DO
  1541.          Node := Node^.AttrOrAction.Next;
  1542.           END;
  1543.           IF Node^.Kind = Tree.ActionPart THEN
  1544.          TheAction^.Action.Next := Node^.ActionPart.Actions;
  1545.          Node^.ActionPart.Actions := TheAction;
  1546.           ELSE
  1547.          Node^.AttrOrAction.Next := mActionPart (nNoAttribute, TheAction);
  1548.           END;
  1549.        END;
  1550.     END;
  1551. }; .
  1552. Child (..) :- {
  1553.     IF Name = Ident THEN Child := Attribute; j := AttrIndex; END;
  1554. }; .
  1555. Attribute (..) :- {
  1556.     IF Name = Ident THEN Child := Attribute; j := AttrIndex; END;
  1557. }; .
  1558.  
  1559.  
  1560. PROCEDURE CopyRule2 (t: Tree)
  1561.  
  1562. Child (..) :-
  1563.    Class # NoTree;
  1564.    Attribute := t;
  1565.    ForallAttributes (Class, CopyRule);
  1566.    .
  1567.  
  1568. PREDICATE IsCopy (Designators)
  1569.  
  1570. Designator (..) :-
  1571.    Attr: tTree, ChildsClass: tTree;
  1572.    Attr := IdentifyAttribute (Class, Selector);
  1573.    Attr # NoTree;
  1574.    Attr^.Kind = Tree.Child;
  1575.    ChildsClass := Attr^.Child.Class;
  1576.    ChildsClass # NoTree;
  1577.    IdentifyAttribute (ChildsClass, Attribute) # NoTree;
  1578.    IsWhiteSpace (Next);
  1579.    .
  1580. Ident (..) :-
  1581.    IdentifyAttribute (Class, Attribute) # NoTree;
  1582.    IsWhiteSpace (Next);
  1583.    .
  1584. Any (..) :-
  1585.    IsWhiteSpace2 (Code);
  1586.    IsCopy (Next);
  1587.    .
  1588. Anys (..) :-
  1589.    IsCopy (Next);
  1590.    .
  1591.  
  1592. PREDICATE IsWhiteSpace (Designators)
  1593.  
  1594. Any (..) :-
  1595.    IsWhiteSpace2 (Code);
  1596.    IsWhiteSpace (Next);
  1597.    .
  1598. Anys (..) :-
  1599.    IsWhiteSpace (Next);
  1600.    .
  1601. NoDesignator (..) :-
  1602.    .
  1603.  
  1604. PREDICATE IsWhiteSpace2 (tStringRef) LOCAL { VAR i: CARDINAL; }
  1605.  
  1606. Code :-
  1607.    String: tString, ch: CHAR;
  1608.    StringMem.GetString (Code, String);
  1609. {  FOR i := 1 TO Length (String) DO
  1610.       ch := Char (String, i);
  1611.       IF (ch # ' ') AND (ch # 012C) AND (ch # 011C) THEN RETURN FALSE; END;
  1612.    END;
  1613. }; .
  1614.